room 750000 u<
[IF]
	cr .( not enough dic room to compile callsMod!) cr  ABORT
[THEN]

false	constant	debug?

file  INPF

: #ALIGN4	\ ( n -- n' )
	3 + $ fffffffc and  ;


true -> case_in_names?

: macConstant
	[ FALSE -> CASE_IN_NAMES? ]
	>in @
	defined?
	IF		<'> inpf u>  IF  2drop  EXIT  THEN
	ELSE	drop
	THEN
	>in !
	constant
;


: [IF]		drop  ;
: [ELSE]	;
: [THEN]	;
: [ELIF]	drop  ;


true -> case_in_names?

: macDefined?	DEFINED? NIP  ;
: macStruct		MWORD DROP  ;
: macUnion		MWORD DROP	;
: macField		DROP  MWORD DROP  ;
: macFiller		2DROP  ;
: macEnd-struct	2DROP  ;
: macEnd-union	2DROP  ;
: macSynonym	MWORD DROP  MWORD DROP  ;

: and			AND  ;
: or			OR   ;
: xor			XOR  ;
: lshift		LSHIFT  ;
: rshift		RSHIFT  ;
: negate		NEGATE  ;
: 'type			POSTPONE 'TYPE  ;  IMMEDIATE


FALSE -> CASE_IN_NAMES?


string temp

: READ_INLINE  { \ loc svd svCaseFlg -- }
	case_in_names? -> svCaseFlg
	false -> case_in_names?
	clear: temp
	BEGIN
		>in @  src-len  >=
		IF	svCaseFlg -> case_in_names?  EXIT
		THEN
		hex  mword number  decimal
		pad w!  pad 2 add: temp
	AGAIN  ;


false	value	register_based?
0		value	^hndlr


	true -> case_in_names?

: macExtern

	[ FALSE -> CASE_IN_NAMES? ]

( result-info parm-info #parms )
		{ \ #parms #cells #fparms #fres mask ^PPCinfo ^68kInfo -- }

	0 -> #cells  0 -> #fparms  false -> register_based?
	0 -> #fres  0 -> mask

	>in @
	defined?
	IF	<'> inpf u>
		IF  drop					\ drop >in - now TOS is # parms
			-1 DO  2drop  LOOP		\ drop parm info, also result info
			0 -> src-len			\ skip 68k inline code sequence
			EXIT
		THEN
	ELSE	drop
	THEN

	>in !
	header						\ create the new dic entry (case sensitive)
	CDP -> ^hndlr
	$ D000  codeW,				\ dummy handler
	CDP -> ^PPCinfo  0 code, 0 codeW,
								\ leave space for PPC info
	
\ #parms
	-> #parms
\	DP -> ^68kInfo
	#parms
	IF
\		pad #parms n,			\ reserve space for rest of 68k parm info
		#parms FOR

		(*	#bytes in next PPC parm - convert to #cells and accumulate.  If
			the $ 1000 bit is set, that means it's floating point - in that
			case we count up the number of floating parms (these have to
			be put in the FPRs for the call), and set the corresponding mask
			bit so that the corresponding GPRs will get a dummy value.  This
			calling convention is a bit crazy, but we're stuck with it.
			Remember as the numbers have been pushed onto the stack, we're
			going from the last parm backwards.  So i in this FOR loop gives
			us the real parm# starting from zero.
		*)
			dup $ 1000 and
			IF				\ it's floating
				1 ++> #fparms
				$ FFF and  dup 4 >
				IF		mask 2 >>  $ C000 or  -> mask	\ mask 2 dummy GPRs here
				ELSE	mask 1 >>  $ 8000 or  -> mask	\ single float - mask 1 GPR
				THEN
			ELSE
				mask 1 >>  -> mask					\ normal GPR cell - no mask bit
			THEN
			3 +  2 >>  ++> #cells

		\ 68k parm info - here on the PPC we just drop it
			drop
		\	i true 68k_parm_adjust	\ check if reg-based and take care of it
		\	^68kInfo i + c!		\ store in right order in 68k info
		NEXT
	THEN

\ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
\ Apparently the call TEGetPoint has a bug in current PPC implementations
\ - the 2 parms are required to be in r4 and r5, instead of r3 and r4!
\ So here we kludge this particular call to think it takes one more
\ cell than it really does.  If Apple fixes the bug, we'll need to delete
\ this code.

	latest n>count  " TEGetPoint" s=
	IF  1 ++> #cells  THEN
	
\ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$

	#cells		^PPCinfo c!			\ store # PPC parm cells at ^PPCinfo

\ ( #68k-res-bytes #PPC-res-bytes )

	dup $ 1000 and
	IF								\ PPC result is floating - so no integer result
		1 -> #fres  drop 0
	ELSE							\ otherwise there's no floating result
		3 +  2 >>
	THEN		^PPCinfo 1+ c!		\ store # PPC integer result cells at ^PPCinfo+1
	#fparms		^PPCinfo 2+ c!		\  and # PPC FP parms at ^PPCinfo+2
	#fres		^PPCinfo 3 + c!		\  and # PPC FP results at ^PPCinfo+3
									\  (must be 0 or 1)
	mask		^PPCinfo 4+  w!

	drop							\ drop 68k result info

\	0 false 68k_parm_adjust  c,	\ store 68k info.  We don't
\								\  round here since we have to know whether
\								\  and by how much to adjust by at the end
\								\  of the call.
\	align-dp
\	read_inline
\	reset: temp  len: temp  w,  all: temp  n,

	0 -> src-len		\ on the PPC we ignore the 68k inline code sequence
;


: FIND_IN_CALLSMOD	\ ( s255 \ svCaseFlg -- cfa true | -- s255 false )
	find: zCallsMod
;


: myHeader
	ppc_header  ;


: KONST  { \ svCaseFlg -- konst }
	case_in_names? -> svCaseFlg
	true -> case_in_names?
	['] find_in_callsMod  -> extraFind
	'
	svCaseFlg -> case_in_names?
	0 -> extraFind
	dup 2- w@  $ BC02 <>  abort" not a konst!"
	2+ @  postpone lit
;		immediate


: $>KONST  { addr len \ svCaseFlg -- konst }
	case_in_names? -> svCaseFlg
	true -> case_in_names?
	['] find_in_callsMod  -> extraFind
	addr len sFind
	svCaseFlg -> case_in_names?
	0 -> extraFind
	NIF  abort" konst not defined"  THEN
	dup 2- w@x  -4 <>  abort" not a konst!"
	@
;


(*
syscall bloggs  defines "bloggs" as an system call (from the InterfaceLib
or MathLib libraries).

In a definition we just put "bloggs" and it compiles a call to bloggs.  We
resolve the symbol via a FindSymbol call, the first time it's called (see
get_transfer_vector in Setup - a call is compiled to there as part of the
external call sequence, compiled by call_extern in cg5).
*)

: SYSCALL  { \	svCaseFlg sv-in addr #parms
				#parm_cells #fparms #res_cells #fres mask
				len ^len-byte  name_len -- }
	?exec
	>in @  -> sv-in

\ first, is it actually a known call?

	case_in_names? -> svCaseFlg
	true -> case_in_names?
	['] find_in_callsMod  -> extraFind
	mword find NIF  150 die  THEN		\ "can't find call for this name"
	0 -> extraFind  svCaseFlg -> case_in_names?
	-> addr
	addr 2- w@
	dup 1 and  -> register_based?
	-2 and  $ D000 <>  abort" not a call!"

\ now, if we've already defined it as a sysCall, and it's currently
\  FINDable, we don't need to define it again here.

	sv-in  >in !
	defined?
	IF	2- w@  $ BF01 =  ?EXIT
	ELSE
		drop
	THEN

	sv-in  >in !
	myHeader  $ BF01  codeW,	\  $BF01 = handler code for sysCall

	addr c@		-> #parm_cells
	addr 1+ c@	-> #res_cells
	addr 2+ c@	-> #fparms
	addr 3 + c@	-> #fres
	addr 4+  w@ -> mask

	#parm_cells codeC,		\ 1 byte # parm cells
	#res_cells codeC,		\ 1 byte # result cells
	#fparms  codeC,			\ 1 byte # FP parms (in FPRs)
	#fres  codeC,			\ 1 byte # FP results (in FPRs)
	mask  codeW,

	DP  nilP ,				\ put nilP in data area - means not resolved yet
	relocCode,				\ and reloc pointer to there in code area
	0 code,					\ for EXTERNs, lib addr goes here.  For SYSCALL,
							\  we put zero.  (This is different to 68k)
	addr >name n>count dup -> name_len
	CDP place					\ and last, the case-sensitive name.
	name_len 2+ #align4  ++> CDP
;


\				=================================
\						Shared libraries
\				=================================


(*
	Usage:

	LIBRARY myLib

	LIBCALL myCall { parm1 parm2 %fparm1 -- res1 }


	The old syntax (Mops 3.2) will still be supported for a while:
	
	1  1 1 1 3  extern  myLib  myCall
	
	or for a floating routine:
	
	1 kFloat or  1 kFloat or  1 kFloat or  2  extern myOtherLib  myFloatGizmo

	defined as:

	EXTERN <lib_name> <call_name>
			( #result_cells #parm1_cells ... #parmN_cells N -- )

*)

: ADD_CASE_SENSITIVE_NAME
	bl word
	count  1+ #align4  ++> CDP
	drop
;

: LIBRARY  { \	svCaseFlg sv-in addr len ^len-byte  name_len -- }
	?exec
	>in @  -> sv-in		\ so we can read the name again case-sensitively

\ if we've already defined it as a library, and it's currently
\  FINDable, we don't need to define it again here.

	defined?
	IF	2- w@  $ BF0B =  ?EXIT
	ELSE
		drop
	THEN

	sv-in  >in !				\ get name again for header
	header  $ BF0B0000  code,	\  $BF0B = handler code for LIBRARY,
								\   plus alignment

	DP  0 ,						\ put 0 in data area - means no connID yet
	relocCode,					\ and reloc pointer to there in code area
	
	sv-in  >in !				\ now we have to get the name again, case-sensitively
	add_case_sensitive_name		\  this time, and just add it to the code area.  We'll
								\  use this when we connect to the library.
;

\				=================================


cr
cr .( Note: loading this next file will take quite a while.)
cr .( A coffee break would be a good idea.)  cr

true -> case_in_names?

// xcalls

FALSE -> CASE_IN_NAMES?

release: temp

cr .( Dic room at end of compiling zCallsMod: )  room . cr